home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fballs.for < prev    next >
Text File  |  1991-06-03  |  3KB  |  150 lines
  1. c
  2. c makesphere
  3. c
  4. c    make a sphere object
  5. c
  6.     subroutine makesp
  7.  
  8.     integer SPHERE
  9.     real r, z, a, RADIUS, PI
  10.     parameter (PI = 3.1415926535, RADIUS = 10.0, SPHERE = 1)
  11.  
  12.     call makeob(SPHERE)
  13.  
  14. c
  15. c create the latitudinal rings
  16. c
  17.         do 10 i = 0, 1800, 200
  18.         call pushma
  19.             call rotate(i, 'y')
  20.             call circ(0.0, 0.0, RADIUS)
  21.         call popmat
  22. 10        continue
  23.         
  24. c
  25. c create the longitudinal rings
  26. c
  27.         call pushma
  28.         call rotate(900, 'x')
  29.         do 20 a = -900, 900, 200
  30.             r = RADIUS * cos(a * PI / 180.0)
  31.             z = RADIUS * sin(a * PI / 180.0)
  32.             call pushma
  33.             call transl(0.0, 0.0, -z)
  34.             call circ(0.0, 0.0, r)
  35.             call popmat
  36. 20        continue
  37.         call popmat
  38.  
  39.     call closeo
  40.  
  41.     end
  42.  
  43. c
  44. c a demonstration of objects
  45. c
  46.     program fballs
  47.  
  48. $INCLUDE: 'fvogl.h'
  49. $INCLUDE: 'fvodevic.h'
  50.  
  51.     integer *2 val
  52.     integer SPHERE
  53.     real RADIUS
  54.     parameter (RADIUS = 10.0)
  55.     parameter(SPHERE = 1)
  56.  
  57.     call winope('fballs', 6)
  58.     call unqdev(INPUTC)
  59.     call qdevic(KEYBD)
  60.  
  61.  
  62. c
  63. c set up our viewing transformation
  64. c
  65.     call perspe(900, 1.0, 0.001, 500.0)
  66.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0)
  67.  
  68.     call color(BLACK)
  69.     call clear
  70.  
  71. c
  72. c Call a routine to make the sphere object
  73. c
  74.     call makesp
  75.  
  76. c
  77. c Now draw the sphere object scaled down. We use the pushmatrix
  78. c and the popmatrix to preserve the transformation matrix so
  79. c that only this sphere is drawn scaled. The callobj then enables
  80. c us to draw the sphere we generated with makeobj in makesphere.
  81. c
  82.     call color(CYAN)
  83.  
  84.     call pushma
  85.         call scale(0.5, 0.5, 0.5)
  86.         call callob(SPHERE)
  87.     call popmat
  88.  
  89. c
  90. c now we draw the same sphere translated, with a different
  91. c scale and color.
  92. c
  93.     call color(WHITE)
  94.  
  95.     call pushma
  96.         call transl(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  97.         call scale(0.3, 0.3, 0.3)
  98.         call callob(SPHERE)
  99.     call popmat
  100.  
  101. c
  102. c and maybe a few more times....
  103. c
  104.  
  105.     call color(RED)
  106.  
  107.     call pushma
  108.         call transl(0.0, RADIUS, 0.7 * RADIUS)
  109.         call scale(0.2, 0.2, 0.2)
  110.         call callob(SPHERE)
  111.     call popmat
  112.  
  113.     call color(GREEN)
  114.  
  115.     call pushma
  116.         call transl(0.0, 1.5 * RADIUS, -RADIUS)
  117.         call scale(0.15, 0.15, 0.15)
  118.         call callob(SPHERE)
  119.     call popmat
  120.  
  121.     call color(YELLOW)
  122.  
  123.     call pushma
  124.         call transl(0.0, -RADIUS, -RADIUS)
  125.         call scale(0.12, 0.12, 0.12)
  126.         call callob(SPHERE)
  127.     call popmat
  128.  
  129.     call color(BLUE)
  130.  
  131.     call pushma
  132.         call transl(0.0, -2.0*RADIUS, -RADIUS)
  133.         call scale(0.3, 0.3, 0.3)
  134.         call callob(SPHERE)
  135.     call popmat
  136.  
  137.     call hfont('times.rb', 8)
  138.     call ortho2(0.0, 1.0, 0.0, 1.0)
  139.     call hcente(.true.)
  140.     call htexts(0.08, 0.15)
  141.     call move2(0.8, 0.5)
  142.     call htexta(-90.0)
  143.     call hchars('I''m very ordinary!', 18)
  144.  
  145.     idum = qread(val)
  146.  
  147.     call gexit
  148.  
  149.     end
  150.